home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 May / Macworld (1998-05).dmg / Serious Demos / TeamWave 3.0 / TeamWave Server / TeamWave Server.rsrc / TEXT_1_History.txt < prev    next >
Text File  |  1998-02-13  |  9KB  |  370 lines
  1. # history.tcl --
  2. #
  3. # Implementation of the history command.
  4. #
  5. # SCCS: @(#) history.tcl 1.7 97/08/07 16:45:50
  6. #
  7. # Copyright (c) 1997 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12.  
  13. # The tcl::history array holds the history list and
  14. # some additional bookkeeping variables.
  15. #
  16. # nextid    the index used for the next history list item.
  17. # keep        the max size of the history list
  18. # oldest    the index of the oldest item in the history.
  19.  
  20. namespace eval tcl {
  21.     variable history
  22.     if ![info exists history] {
  23.     array set history {
  24.         nextid    0
  25.         keep    20
  26.         oldest    -20
  27.     }
  28.     }
  29. }
  30.  
  31. # history --
  32. #
  33. #    This is the main history command.  See the man page for its interface.
  34. #    This does argument checking and calls helper procedures in the
  35. #    history namespace.
  36.  
  37. proc history {args} {
  38.     set len [llength $args]
  39.     if {$len == 0} {
  40.     return [tcl::HistInfo]
  41.     }
  42.     set key [lindex $args 0]
  43.     set options "add, change, clear, event, info, keep, nextid, or redo"
  44.     switch -glob -- $key {
  45.     a* { # history add
  46.  
  47.         if {$len > 3} {
  48.         return -code error "wrong # args: should be \"history add event ?exec?\""
  49.         }
  50.         if {![string match $key* add]} {
  51.         return -code error "bad option \"$key\": must be $options"
  52.         }
  53.         if {$len == 3} {
  54.         set arg [lindex $args 2]
  55.         if {! ([string match e* $arg] && [string match $arg* exec])} {
  56.             return -code error "bad argument \"$arg\": should be \"exec\""
  57.         }
  58.         }
  59.         return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
  60.     }
  61.     ch* { # history change
  62.  
  63.         if {($len > 3) || ($len < 2)} {
  64.         return -code error "wrong # args: should be \"history change newValue ?event?\""
  65.         }
  66.         if {![string match $key* change]} {
  67.         return -code error "bad option \"$key\": must be $options"
  68.         }
  69.         if {$len == 2} {
  70.         set event 0
  71.         } else {
  72.         set event [lindex $args 2]
  73.         }
  74.  
  75.         return [tcl::HistChange [lindex $args 1] $event]
  76.     }
  77.     cl* { # history clear
  78.  
  79.         if {($len > 1)} {
  80.         return -code error "wrong # args: should be \"history clear\""
  81.         }
  82.         if {![string match $key* clear]} {
  83.         return -code error "bad option \"$key\": must be $options"
  84.         }
  85.         return [tcl::HistClear]
  86.     }
  87.     e* { # history event
  88.  
  89.         if {$len > 2} {
  90.         return -code error "wrong # args: should be \"history event ?event?\""
  91.         }
  92.         if {![string match $key* event]} {
  93.         return -code error "bad option \"$key\": must be $options"
  94.         }
  95.         if {$len == 1} {
  96.         set event -1
  97.         } else {
  98.         set event [lindex $args 1]
  99.         }
  100.         return [tcl::HistEvent $event]
  101.     }
  102.     i* { # history info
  103.  
  104.         if {$len > 2} {
  105.         return -code error "wrong # args: should be \"history info ?count?\""
  106.         }
  107.         if {![string match $key* info]} {
  108.         return -code error "bad option \"$key\": must be $options"
  109.         }
  110.         return [tcl::HistInfo [lindex $args 1]]
  111.     }
  112.     k* { # history keep
  113.  
  114.         if {$len > 2} {
  115.         return -code error "wrong # args: should be \"history keep ?count?\""
  116.         }
  117.         if {$len == 1} {
  118.         return [tcl::HistKeep]
  119.         } else {
  120.         set limit [lindex $args 1]
  121.         if {[catch {expr $limit}] || ($limit < 0)} {
  122.             return -code error "illegal keep count \"$limit\""
  123.         }
  124.         return [tcl::HistKeep $limit]
  125.         }
  126.     }
  127.     n* { # history nextid
  128.  
  129.         if {$len > 1} {
  130.         return -code error "wrong # args: should be \"history nextid\""
  131.         }
  132.         if {![string match $key* nextid]} {
  133.         return -code error "bad option \"$key\": must be $options"
  134.         }
  135.         return [expr $tcl::history(nextid) + 1]
  136.     }
  137.     r* { # history redo
  138.  
  139.         if {$len > 2} {
  140.         return -code error "wrong # args: should be \"history redo ?event?\""
  141.         }
  142.         if {![string match $key* redo]} {
  143.         return -code error "bad option \"$key\": must be $options"
  144.         }
  145.         return [tcl::HistRedo [lindex $args 1]]
  146.     }
  147.     default {
  148.         return -code error "bad option \"$key\": must be $options"
  149.     }
  150.     }
  151. }
  152.  
  153. # tcl::HistAdd --
  154. #
  155. #    Add an item to the history, and optionally eval it at the global scope
  156. #
  157. # Parameters:
  158. #    command        the command to add
  159. #    exec        (optional) a substring of "exec" causes the
  160. #            command to be evaled.
  161. # Results:
  162. #     If executing, then the results of the command are returned
  163. #
  164. # Side Effects:
  165. #    Adds to the history list
  166.  
  167.  proc tcl::HistAdd {command {exec {}}} {
  168.     variable history
  169.     set i [incr history(nextid)]
  170.     set history($i) $command
  171.     set j [incr history(oldest)]
  172.     if {[info exists history($j)]} {unset history($j)}
  173.     if {[string match e* $exec]} {
  174.     return [uplevel #0 $command]
  175.     } else {
  176.     return {}
  177.     }
  178. }
  179.  
  180. # tcl::HistKeep --
  181. #
  182. #    Set or query the limit on the length of the history list
  183. #
  184. # Parameters:
  185. #    limit    (optional) the length of the history list
  186. #
  187. # Results:
  188. #    If no limit is specified, the current limit is returned
  189. #
  190. # Side Effects:
  191. #    Updates history(keep) if a limit is specified
  192.  
  193.  proc tcl::HistKeep {{limit {}}} {
  194.     variable history
  195.     if {[string length $limit] == 0} {
  196.     return $history(keep)
  197.     } else {
  198.     set oldold $history(oldest)
  199.     set history(oldest) [expr $history(nextid) - $limit]
  200.     for {} {$oldold <= $history(oldest)} {incr oldold} {
  201.         if {[info exists history($oldold)]} {unset history($oldold)}
  202.     }
  203.     set history(keep) $limit
  204.     }
  205. }
  206.  
  207. # tcl::HistClear --
  208. #
  209. #    Erase the history list
  210. #
  211. # Parameters:
  212. #    none
  213. #
  214. # Results:
  215. #    none
  216. #
  217. # Side Effects:
  218. #    Resets the history array, except for the keep limit
  219.  
  220.  proc tcl::HistClear {} {
  221.     variable history
  222.     set keep $history(keep)
  223.     unset history
  224.     array set history [list \
  225.     nextid    0    \
  226.     keep    $keep    \
  227.     oldest    -$keep    \
  228.     ]
  229. }
  230.  
  231. # tcl::HistInfo --
  232. #
  233. #    Return a pretty-printed version of the history list
  234. #
  235. # Parameters:
  236. #    num    (optional) the length of the history list to return
  237. #
  238. # Results:
  239. #    A formatted history list
  240.  
  241.  proc tcl::HistInfo {{num {}}} {
  242.     variable history
  243.     if {$num == {}} {
  244.     set num [expr $history(keep) + 1]
  245.     }
  246.     set result {}
  247.     set newline ""
  248.     for {set i [expr $history(nextid) - $num + 1]} \
  249.         {$i <= $history(nextid)} {incr i} {
  250.     if ![info exists history($i)] {
  251.         continue
  252.     }
  253.     set cmd [string trimright $history($i) \ \n]
  254.     regsub -all \n $cmd "\n\t" cmd
  255.     append result $newline[format "%6d  %s" $i $cmd]
  256.     set newline \n
  257.     }
  258.     return $result
  259. }
  260.  
  261. # tcl::HistRedo --
  262. #
  263. #    Fetch the previous or specified event, execute it, and then
  264. #    replace the current history item with that event.
  265. #
  266. # Parameters:
  267. #    event    (optional) index of history item to redo.  Defaults to -1,
  268. #        which means the previous event.
  269. #
  270. # Results:
  271. #    Those of the command being redone.
  272. #
  273. # Side Effects:
  274. #    Replaces the current history list item with the one being redone.
  275.  
  276.  proc tcl::HistRedo {{event -1}} {
  277.     variable history
  278.     if {[string length $event] == 0} {
  279.     set event -1
  280.     }
  281.     set i [HistIndex $event]
  282.     if {$i == $history(nextid)} {
  283.     return -code error "cannot redo the current event"
  284.     }
  285.     set cmd $history($i)
  286.     HistChange $cmd 0
  287.     uplevel #0 $cmd
  288. }
  289.  
  290. # tcl::HistIndex --
  291. #
  292. #    Map from an event specifier to an index in the history list.
  293. #
  294. # Parameters:
  295. #    event    index of history item to redo.
  296. #        If this is a positive number, it is used directly.
  297. #        If it is a negative number, then it counts back to a previous
  298. #        event, where -1 is the most recent event.
  299. #        A string can be matched, either by being the prefix of
  300. #        a command or by matching a command with string match.
  301. #
  302. # Results:
  303. #    The index into history, or an error if the index didn't match.
  304.  
  305.  proc tcl::HistIndex {event} {
  306.     variable history
  307.     if {[catch {expr $event}]} {
  308.     for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {
  309.         if {[string match $event* $history($i)]} {
  310.         return $i;
  311.         }
  312.         if {[string match $event $history($i)]} {
  313.         return $i;
  314.         }
  315.     }
  316.     return -code error "no event matches \"$event\""
  317.     } elseif {$event <= 0} {
  318.     set i [expr $history(nextid) + $event]
  319.     } else {
  320.     set i $event
  321.     }
  322.     if {$i <= $history(oldest)} {
  323.     return -code error "event \"$event\" is too far in the past"
  324.     }
  325.     if {$i > $history(nextid)} {
  326.     return -code error "event \"$event\" hasn't occured yet"
  327.     }
  328.     return $i
  329. }
  330.  
  331. # tcl::HistEvent --
  332. #
  333. #    Map from an event specifier to the value in the history list.
  334. #
  335. # Parameters:
  336. #    event    index of history item to redo.  See index for a
  337. #        description of possible event patterns.
  338. #
  339. # Results:
  340. #    The value from the history list.
  341.  
  342.  proc tcl::HistEvent {event} {
  343.     variable history
  344.     set i [HistIndex $event]
  345.     if {[info exists history($i)]} {
  346.     return [string trimright $history($i) \ \n]
  347.     } else {
  348.     return "";
  349.     }
  350. }
  351.  
  352. # tcl::HistChange --
  353. #
  354. #    Replace a value in the history list.
  355. #
  356. # Parameters:
  357. #    cmd    The new value to put into the history list.
  358. #    event    (optional) index of history item to redo.  See index for a
  359. #        description of possible event patterns.  This defaults
  360. #        to 0, which specifies the current event.
  361. #
  362. # Side Effects:
  363. #    Changes the history list.
  364.  
  365.  proc tcl::HistChange {cmd {event 0}} {
  366.     variable history
  367.     set i [HistIndex $event]
  368.     set history($i) $cmd
  369. }
  370.